;;; Compiled by f2cl version:
;;; ("$Id: f2cl1.l,v 1.209 2008/09/11 14:59:55 rtoy Exp $"
;;;  "$Id: f2cl2.l,v 1.37 2008/02/22 22:19:33 rtoy Rel $"
;;;  "$Id: f2cl3.l,v 1.6 2008/02/22 22:19:33 rtoy Rel $"
;;;  "$Id: f2cl4.l,v 1.7 2008/02/22 22:19:34 rtoy Rel $"
;;;  "$Id: f2cl5.l,v 1.197 2008/09/11 15:03:25 rtoy Exp $"
;;;  "$Id: f2cl6.l,v 1.48 2008/08/24 00:56:27 rtoy Exp $"
;;;  "$Id: macros.l,v 1.106 2008/09/15 15:27:36 rtoy Exp $")

;;; Using Lisp International Allegro CL Enterprise Edition 8.1 [64-bit Linux (x86-64)] (Oct 7, 2008 17:13)
;;;
;;; Options: ((:prune-labels nil) (:auto-save t)
;;;           (:relaxed-array-decls t) (:coerce-assigns :as-needed)
;;;           (:array-type ':array) (:array-slicing t)
;;;           (:declare-common nil) (:float-format double-float))

(in-package :clml.lapack)


(let* ((maxit 20)
       (zero 0.0)
       (one 1.0)
       (two 2.0)
       (three 3.0)
       (four 4.0)
       (eight 8.0)
       (ten 10.0))
  (declare (type (f2cl-lib:integer4 20 20) maxit)
   (type (double-float 0.0 0.0) zero) (type (double-float 1.0 1.0) one)
   (type (double-float 2.0 2.0) two)
   (type (double-float 3.0 3.0) three)
   (type (double-float 4.0 4.0) four)
   (type (double-float 8.0 8.0) eight)
   (type (double-float 10.0 10.0) ten)
   (ignorable maxit zero one two three four eight ten))
  (defun dlasd4 (n i d z delta rho sigma work info)
    (declare (type (double-float) sigma rho)
     (type (array double-float (*)) work delta z d)
     (type (f2cl-lib:integer4) info i n))
    (f2cl-lib:with-multi-array-data ((d double-float d-%data%
                                      d-%offset%)
                                     (z double-float z-%data%
                                      z-%offset%)
                                     (delta double-float delta-%data%
                                      delta-%offset%)
                                     (work double-float work-%data%
                                      work-%offset%))
      (prog ((dd (make-array 3 :element-type 'double-float))
             (zz (make-array 3 :element-type 'double-float)) (a 0.0)
             (b 0.0) (c 0.0) (delsq 0.0) (delsq2 0.0) (dphi 0.0)
             (dpsi 0.0) (dtiim 0.0) (dtiip 0.0) (dtipsq 0.0)
             (dtisq 0.0) (dtnsq 0.0) (dtnsq1 0.0) (dw 0.0) (eps 0.0)
             (erretm 0.0) (eta 0.0) (phi 0.0) (prew 0.0) (psi 0.0)
             (rhoinv 0.0) (sg2lb 0.0) (sg2ub 0.0) (tau 0.0) (temp 0.0)
             (temp1 0.0) (temp2 0.0) (w 0.0) (ii 0) (iim1 0) (iip1 0)
             (ip1 0) (iter 0) (j 0) (niter 0) (orgati nil) (swtch nil)
             (swtch3 nil))
            (declare
             (type (double-float) a b c delsq delsq2 dphi dpsi dtiim
              dtiip dtipsq dtisq dtnsq dtnsq1 dw eps erretm eta phi
              prew psi rhoinv sg2lb sg2ub tau temp temp1 temp2 w)
             (type f2cl-lib:logical orgati swtch swtch3)
             (type (array double-float (3)) dd zz)
             (type (f2cl-lib:integer4) ii iim1 iip1 ip1 iter j niter))
            (setf info 0)
            (cond ((= n 1)
                   (setf sigma
                         (f2cl-lib:fsqrt (+ (* (f2cl-lib:fref d-%data%
                                                              (1)
                                                              ((1 *))
                                                              d-%offset%)
                                               (f2cl-lib:fref d-%data%
                                                              (1)
                                                              ((1 *))
                                                              d-%offset%))
                                            (* rho
                                               (f2cl-lib:fref z-%data%
                                                              (1)
                                                              ((1 *))
                                                              z-%offset%)
                                               (f2cl-lib:fref z-%data%
                                                              (1)
                                                              ((1 *))
                                                              z-%offset%)))))
                   (setf (f2cl-lib:fref delta-%data% (1) ((1 *))
                                        delta-%offset%)
                         one)
                   (setf (f2cl-lib:fref work-%data% (1) ((1 *))
                                        work-%offset%)
                         one)
                   (go end_label)))
            (cond ((= n 2)
                   (multiple-value-bind (var-0 var-1 var-2 var-3 var-4
                                         var-5 var-6)
                       (dlasd5 i d z delta rho sigma work)
                     (declare
                      (ignore var-0 var-1 var-2 var-3 var-4 var-6))
                     (setf sigma var-5))
                   (go end_label)))
            (setf eps (dlamch "Epsilon"))
            (setf rhoinv (/ one rho))
            (cond ((= i n)
                   (setf ii (f2cl-lib:int-sub n 1))
                   (setf niter 1)
                   (setf temp (/ rho two))
                   (setf temp1
                         (/ temp
                            (+ (f2cl-lib:fref d-%data% (n) ((1 *))
                                              d-%offset%)
                               (f2cl-lib:fsqrt (+ (* (f2cl-lib:fref d-%data%
                                                                    (n)
                                                                    ((1
                                                                      *))
                                                                    d-%offset%)
                                                     (f2cl-lib:fref d-%data%
                                                                    (n)
                                                                    ((1
                                                                      *))
                                                                    d-%offset%))
                                                  temp)))))
                   (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
                                 ((> j n) nil)
                                 (tagbody
                                     (setf (f2cl-lib:fref work-%data%
                                                          (j) ((1 *))
                                                          work-%offset%)
                                           (+ (f2cl-lib:fref d-%data%
                                                             (j)
                                                             ((1 *))
                                                             d-%offset%)
                                              (f2cl-lib:fref d-%data%
                                                             (n)
                                                             ((1 *))
                                                             d-%offset%)
                                              temp1))
                                     (setf (f2cl-lib:fref delta-%data%
                                                          (j) ((1 *))
                                                          delta-%offset%)
                                           (- (f2cl-lib:fref d-%data%
                                                             (j)
                                                             ((1 *))
                                                             d-%offset%)
                                              (f2cl-lib:fref d-%data%
                                                             (n)
                                                             ((1 *))
                                                             d-%offset%)
                                              temp1))
                                   label10))
                   (setf psi zero)
                   (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
                                 ((> j
                                     (f2cl-lib:int-add n
                                                       (f2cl-lib:int-sub 2)))
                                  nil)
                                 (tagbody
                                     (setf psi
                                           (+ psi
                                              (/ (* (f2cl-lib:fref z-%data%
                                                                   (j)
                                                                   ((1
                                                                     *))
                                                                   z-%offset%)
                                                    (f2cl-lib:fref z-%data%
                                                                   (j)
                                                                   ((1
                                                                     *))
                                                                   z-%offset%))
                                                 (* (f2cl-lib:fref delta-%data%
                                                                   (j)
                                                                   ((1
                                                                     *))
                                                                   delta-%offset%)
                                                    (f2cl-lib:fref work-%data%
                                                                   (j)
                                                                   ((1
                                                                     *))
                                                                   work-%offset%)))))
                                   label20))
                   (setf c (+ rhoinv psi))
                   (setf w
                         (+ c
                            (/ (* (f2cl-lib:fref z-%data% (ii) ((1 *))
                                                 z-%offset%)
                                  (f2cl-lib:fref z-%data% (ii) ((1 *))
                                                 z-%offset%))
                               (* (f2cl-lib:fref delta-%data% (ii)
                                                 ((1 *))
                                                 delta-%offset%)
                                  (f2cl-lib:fref work-%data% (ii)
                                                 ((1 *))
                                                 work-%offset%)))
                            (/ (* (f2cl-lib:fref z-%data% (n) ((1 *))
                                                 z-%offset%)
                                  (f2cl-lib:fref z-%data% (n) ((1 *))
                                                 z-%offset%))
                               (* (f2cl-lib:fref delta-%data% (n)
                                                 ((1 *))
                                                 delta-%offset%)
                                  (f2cl-lib:fref work-%data% (n)
                                                 ((1 *))
                                                 work-%offset%)))))
                   (cond ((<= w zero)
                          (setf temp1
                                (f2cl-lib:fsqrt (+ (* (f2cl-lib:fref d-%data%
                                                                     (n)
                                                                     ((1
                                                                       *))
                                                                     d-%offset%)
                                                      (f2cl-lib:fref d-%data%
                                                                     (n)
                                                                     ((1
                                                                       *))
                                                                     d-%offset%))
                                                   rho)))
                          (setf temp
                                (+ (/ (* (f2cl-lib:fref z-%data%
                                                        ((f2cl-lib:int-sub n
                                                                           1))
                                                        ((1 *))
                                                        z-%offset%)
                                         (f2cl-lib:fref z-%data%
                                                        ((f2cl-lib:int-sub n
                                                                           1))
                                                        ((1 *))
                                                        z-%offset%))
                                      (* (+ (f2cl-lib:fref d-%data%
                                                           ((f2cl-lib:int-sub n
                                                                              1))
                                                           ((1 *))
                                                           d-%offset%)
                                            temp1)
                                         (+ (- (f2cl-lib:fref d-%data%
                                                              (n)
                                                              ((1 *))
                                                              d-%offset%)
                                               (f2cl-lib:fref d-%data%
                                                              ((f2cl-lib:int-sub n
                                                                                 1))
                                                              ((1 *))
                                                              d-%offset%))
                                            (/ rho
                                               (+ (f2cl-lib:fref d-%data%
                                                                 (n)
                                                                 ((1
                                                                   *))
                                                                 d-%offset%)
                                                  temp1)))))
                                   (/ (* (f2cl-lib:fref z-%data% (n)
                                                        ((1 *))
                                                        z-%offset%)
                                         (f2cl-lib:fref z-%data% (n)
                                                        ((1 *))
                                                        z-%offset%))
                                      rho)))
                          (cond ((<= c temp) (setf tau rho))
                                (t
                                 (setf delsq
                                       (* (- (f2cl-lib:fref d-%data%
                                                            (n) ((1 *))
                                                            d-%offset%)
                                             (f2cl-lib:fref d-%data%
                                                            ((f2cl-lib:int-sub n
                                                                               1))
                                                            ((1 *))
                                                            d-%offset%))
                                          (+ (f2cl-lib:fref d-%data%
                                                            (n) ((1 *))
                                                            d-%offset%)
                                             (f2cl-lib:fref d-%data%
                                                            ((f2cl-lib:int-sub n
                                                                               1))
                                                            ((1 *))
                                                            d-%offset%))))
                                 (setf a
                                       (+ (* (- c) delsq)
                                          (* (f2cl-lib:fref z-%data%
                                                            ((f2cl-lib:int-sub n
                                                                               1))
                                                            ((1 *))
                                                            z-%offset%)
                                             (f2cl-lib:fref z-%data%
                                                            ((f2cl-lib:int-sub n
                                                                               1))
                                                            ((1 *))
                                                            z-%offset%))
                                          (* (f2cl-lib:fref z-%data%
                                                            (n) ((1 *))
                                                            z-%offset%)
                                             (f2cl-lib:fref z-%data%
                                                            (n) ((1 *))
                                                            z-%offset%))))
                                 (setf b
                                       (* (f2cl-lib:fref z-%data% (n)
                                                         ((1 *))
                                                         z-%offset%)
                                          (f2cl-lib:fref z-%data% (n)
                                                         ((1 *))
                                                         z-%offset%)
                                          delsq))
                                 (cond ((< a zero)
                                        (setf tau
                                              (/ (* two b)
                                                 (- (f2cl-lib:fsqrt (+ (* a
                                                                          a)
                                                                       (* four
                                                                          b
                                                                          c)))
                                                    a))))
                                       (t
                                        (setf tau
                                              (/ (+ a
                                                    (f2cl-lib:fsqrt (+ (* a
                                                                          a)
                                                                       (* four
                                                                          b
                                                                          c))))
                                                 (* two c))))))))
                         (t
                          (setf delsq
                                (* (- (f2cl-lib:fref d-%data% (n)
                                                     ((1 *))
                                                     d-%offset%)
                                      (f2cl-lib:fref d-%data%
                                                     ((f2cl-lib:int-sub n
                                                                        1))
                                                     ((1 *))
                                                     d-%offset%))
                                   (+ (f2cl-lib:fref d-%data% (n)
                                                     ((1 *))
                                                     d-%offset%)
                                      (f2cl-lib:fref d-%data%
                                                     ((f2cl-lib:int-sub n
                                                                        1))
                                                     ((1 *))
                                                     d-%offset%))))
                          (setf a
                                (+ (* (- c) delsq)
                                   (* (f2cl-lib:fref z-%data%
                                                     ((f2cl-lib:int-sub n
                                                                        1))
                                                     ((1 *))
                                                     z-%offset%)
                                      (f2cl-lib:fref z-%data%
                                                     ((f2cl-lib:int-sub n
                                                                        1))
                                                     ((1 *))
                                                     z-%offset%))
                                   (* (f2cl-lib:fref z-%data% (n)
                                                     ((1 *))
                                                     z-%offset%)
                                      (f2cl-lib:fref z-%data% (n)
                                                     ((1 *))
                                                     z-%offset%))))
                          (setf b
                                (* (f2cl-lib:fref z-%data% (n) ((1 *))
                                                  z-%offset%)
                                   (f2cl-lib:fref z-%data% (n) ((1 *))
                                                  z-%offset%)
                                   delsq))
                          (cond ((< a zero)
                                 (setf tau
                                       (/ (* two b)
                                          (- (f2cl-lib:fsqrt (+ (* a a)
                                                                (* four
                                                                   b
                                                                   c)))
                                             a))))
                                (t
                                 (setf tau
                                       (/ (+ a
                                             (f2cl-lib:fsqrt (+ (* a a)
                                                                (* four
                                                                   b
                                                                   c))))
                                          (* two c)))))))
                   (setf eta
                         (/ tau
                            (+ (f2cl-lib:fref d-%data% (n) ((1 *))
                                              d-%offset%)
                               (f2cl-lib:fsqrt (+ (* (f2cl-lib:fref d-%data%
                                                                    (n)
                                                                    ((1
                                                                      *))
                                                                    d-%offset%)
                                                     (f2cl-lib:fref d-%data%
                                                                    (n)
                                                                    ((1
                                                                      *))
                                                                    d-%offset%))
                                                  tau)))))
                   (setf sigma
                         (+ (f2cl-lib:fref d-%data% (n) ((1 *))
                                           d-%offset%)
                            eta))
                   (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
                                 ((> j n) nil)
                                 (tagbody
                                     (setf (f2cl-lib:fref delta-%data%
                                                          (j) ((1 *))
                                                          delta-%offset%)
                                           (- (f2cl-lib:fref d-%data%
                                                             (j)
                                                             ((1 *))
                                                             d-%offset%)
                                              (f2cl-lib:fref d-%data%
                                                             (i)
                                                             ((1 *))
                                                             d-%offset%)
                                              eta))
                                     (setf (f2cl-lib:fref work-%data%
                                                          (j) ((1 *))
                                                          work-%offset%)
                                           (+ (f2cl-lib:fref d-%data%
                                                             (j)
                                                             ((1 *))
                                                             d-%offset%)
                                              (f2cl-lib:fref d-%data%
                                                             (i)
                                                             ((1 *))
                                                             d-%offset%)
                                              eta))
                                   label30))
                   (setf dpsi zero)
                   (setf psi zero)
                   (setf erretm zero)
                   (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
                                 ((> j ii) nil)
                                 (tagbody
                                     (setf temp
                                           (/ (f2cl-lib:fref z-%data%
                                                             (j)
                                                             ((1 *))
                                                             z-%offset%)
                                              (* (f2cl-lib:fref delta-%data%
                                                                (j)
                                                                ((1 *))
                                                                delta-%offset%)
                                                 (f2cl-lib:fref work-%data%
                                                                (j)
                                                                ((1 *))
                                                                work-%offset%))))
                                     (setf psi
                                           (+ psi
                                              (* (f2cl-lib:fref z-%data%
                                                                (j)
                                                                ((1 *))
                                                                z-%offset%)
                                                 temp)))
                                     (setf dpsi (+ dpsi (* temp temp)))
                                     (setf erretm (+ erretm psi))
                                   label40))
                   (setf erretm (abs erretm))
                   (setf temp
                         (/ (f2cl-lib:fref z-%data% (n) ((1 *))
                                           z-%offset%)
                            (* (f2cl-lib:fref delta-%data% (n) ((1 *))
                                              delta-%offset%)
                               (f2cl-lib:fref work-%data% (n) ((1 *))
                                              work-%offset%))))
                   (setf phi
                         (* (f2cl-lib:fref z-%data% (n) ((1 *))
                                           z-%offset%)
                            temp))
                   (setf dphi (* temp temp))
                   (setf erretm
                         (+ (- (+ (* eight (- (- psi) phi)) erretm)
                               phi)
                            rhoinv (* (abs tau) (+ dpsi dphi))))
                   (setf w (+ rhoinv phi psi))
                   (cond ((<= (abs w) (* eps erretm)) (go label240)))
                   (setf niter (f2cl-lib:int-add niter 1))
                   (setf dtnsq1
                         (* (f2cl-lib:fref work-%data%
                                           ((f2cl-lib:int-sub n 1))
                                           ((1 *)) work-%offset%)
                            (f2cl-lib:fref delta-%data%
                                           ((f2cl-lib:int-sub n 1))
                                           ((1 *)) delta-%offset%)))
                   (setf dtnsq
                         (* (f2cl-lib:fref work-%data% (n) ((1 *))
                                           work-%offset%)
                            (f2cl-lib:fref delta-%data% (n) ((1 *))
                                           delta-%offset%)))
                   (setf c (- w (* dtnsq1 dpsi) (* dtnsq dphi)))
                   (setf a
                         (+ (* (+ dtnsq dtnsq1) w)
                            (* (- dtnsq) dtnsq1 (+ dpsi dphi))))
                   (setf b (* dtnsq dtnsq1 w))
                   (if (< c zero) (setf c (abs c)))
                   (cond ((= c zero)
                          (setf eta (- rho (* sigma sigma))))
                         ((>= a zero)
                          (setf eta
                                (/ (+ a
                                      (f2cl-lib:fsqrt (abs (+ (* a a)
                                                              (* (- four)
                                                                 b
                                                                 c)))))
                                   (* two c))))
                         (t
                          (setf eta
                                (/ (* two b)
                                   (- a
                                      (f2cl-lib:fsqrt (abs (+ (* a a)
                                                              (* (- four)
                                                                 b
                                                                 c)))))))))
                   (if (> (* w eta) zero)
                       (setf eta (/ (- w) (+ dpsi dphi))))
                   (setf temp (- eta dtnsq))
                   (if (> temp rho) (setf eta (+ rho dtnsq)))
                   (setf tau (+ tau eta))
                   (setf eta
                         (/ eta
                            (+ sigma
                               (f2cl-lib:fsqrt (+ eta
                                                  (* sigma sigma))))))
                   (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
                                 ((> j n) nil)
                                 (tagbody
                                     (setf (f2cl-lib:fref delta-%data%
                                                          (j) ((1 *))
                                                          delta-%offset%)
                                           (- (f2cl-lib:fref delta-%data%
                                                             (j)
                                                             ((1 *))
                                                             delta-%offset%)
                                              eta))
                                     (setf (f2cl-lib:fref work-%data%
                                                          (j) ((1 *))
                                                          work-%offset%)
                                           (+ (f2cl-lib:fref work-%data%
                                                             (j)
                                                             ((1 *))
                                                             work-%offset%)
                                              eta))
                                   label50))
                   (setf sigma (+ sigma eta))
                   (setf dpsi zero)
                   (setf psi zero)
                   (setf erretm zero)
                   (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
                                 ((> j ii) nil)
                                 (tagbody
                                     (setf temp
                                           (/ (f2cl-lib:fref z-%data%
                                                             (j)
                                                             ((1 *))
                                                             z-%offset%)
                                              (* (f2cl-lib:fref work-%data%
                                                                (j)
                                                                ((1 *))
                                                                work-%offset%)
                                                 (f2cl-lib:fref delta-%data%
                                                                (j)
                                                                ((1 *))
                                                                delta-%offset%))))
                                     (setf psi
                                           (+ psi
                                              (* (f2cl-lib:fref z-%data%
                                                                (j)
                                                                ((1 *))
                                                                z-%offset%)
                                                 temp)))
                                     (setf dpsi (+ dpsi (* temp temp)))
                                     (setf erretm (+ erretm psi))
                                   label60))
                   (setf erretm (abs erretm))
                   (setf temp
                         (/ (f2cl-lib:fref z-%data% (n) ((1 *))
                                           z-%offset%)
                            (* (f2cl-lib:fref work-%data% (n) ((1 *))
                                              work-%offset%)
                               (f2cl-lib:fref delta-%data% (n) ((1 *))
                                              delta-%offset%))))
                   (setf phi
                         (* (f2cl-lib:fref z-%data% (n) ((1 *))
                                           z-%offset%)
                            temp))
                   (setf dphi (* temp temp))
                   (setf erretm
                         (+ (- (+ (* eight (- (- psi) phi)) erretm)
                               phi)
                            rhoinv (* (abs tau) (+ dpsi dphi))))
                   (setf w (+ rhoinv phi psi))
                   (setf iter (f2cl-lib:int-add niter 1))
                   (f2cl-lib:fdo (niter iter
                                  (f2cl-lib:int-add niter 1))
                                 ((> niter maxit) nil)
                                 (tagbody
                                     (cond ((<= (abs w) (* eps erretm))
                                            (go label240)))
                                     (setf dtnsq1
                                           (* (f2cl-lib:fref work-%data%
                                                             ((f2cl-lib:int-sub n
                                                                                1))
                                                             ((1 *))
                                                             work-%offset%)
                                              (f2cl-lib:fref delta-%data%
                                                             ((f2cl-lib:int-sub n
                                                                                1))
                                                             ((1 *))
                                                             delta-%offset%)))
                                     (setf dtnsq
                                           (* (f2cl-lib:fref work-%data%
                                                             (n)
                                                             ((1 *))
                                                             work-%offset%)
                                              (f2cl-lib:fref delta-%data%
                                                             (n)
                                                             ((1 *))
                                                             delta-%offset%)))
                                     (setf c
                                           (- w (* dtnsq1 dpsi)
                                              (* dtnsq dphi)))
                                     (setf a
                                           (+ (* (+ dtnsq dtnsq1) w)
                                              (* (- dtnsq1) dtnsq
                                                 (+ dpsi dphi))))
                                     (setf b (* dtnsq1 dtnsq w))
                                     (cond ((>= a zero)
                                            (setf eta
                                                  (/ (+ a
                                                        (f2cl-lib:fsqrt (abs (+ (* a
                                                                                   a)
                                                                                (* (- four)
                                                                                   b
                                                                                   c)))))
                                                     (* two c))))
                                           (t
                                            (setf eta
                                                  (/ (* two b)
                                                     (- a
                                                        (f2cl-lib:fsqrt (abs (+ (* a
                                                                                   a)
                                                                                (* (- four)
                                                                                   b
                                                                                   c)))))))))
                                     (if (> (* w eta) zero)
                                         (setf eta
                                               (/ (- w)
                                                  (+ dpsi dphi))))
                                     (setf temp (- eta dtnsq))
                                     (if (<= temp zero)
                                         (setf eta (/ eta two)))
                                     (setf tau (+ tau eta))
                                     (setf eta
                                           (/ eta
                                              (+ sigma
                                                 (f2cl-lib:fsqrt (+ eta
                                                                    (* sigma
                                                                       sigma))))))
                                     (f2cl-lib:fdo (j 1
                                                    (f2cl-lib:int-add j
                                                                      1))
                                                   ((> j n) nil)
                                                   (tagbody
                                                       (setf (f2cl-lib:fref delta-%data%
                                                                            (j)
                                                                            ((1
                                                                              *))
                                                                            delta-%offset%)
                                                             (- (f2cl-lib:fref delta-%data%
                                                                               (j)
                                                                               ((1
                                                                                 *))
                                                                               delta-%offset%)
                                                                eta))
                                                       (setf (f2cl-lib:fref work-%data%
                                                                            (j)
                                                                            ((1
                                                                              *))
                                                                            work-%offset%)
                                                             (+ (f2cl-lib:fref work-%data%
                                                                               (j)
                                                                               ((1
                                                                                 *))
                                                                               work-%offset%)
                                                                eta))
                                                     label70))
                                     (setf sigma (+ sigma eta))
                                     (setf dpsi zero)
                                     (setf psi zero)
                                     (setf erretm zero)
                                     (f2cl-lib:fdo (j 1
                                                    (f2cl-lib:int-add j
                                                                      1))
                                                   ((> j ii) nil)
                                                   (tagbody
                                                       (setf temp
                                                             (/ (f2cl-lib:fref z-%data%
                                                                               (j)
                                                                               ((1
                                                                                 *))
                                                                               z-%offset%)
                                                                (* (f2cl-lib:fref work-%data%
                                                                                  (j)
                                                                                  ((1
                                                                                    *))
                                                                                  work-%offset%)
                                                                   (f2cl-lib:fref delta-%data%
                                                                                  (j)
                                                                                  ((1
                                                                                    *))
                                                                                  delta-%offset%))))
                                                       (setf psi
                                                             (+ psi
                                                                (* (f2cl-lib:fref z-%data%
                                                                                  (j)
                                                                                  ((1
                                                                                    *))
                                                                                  z-%offset%)
                                                                   temp)))
                                                       (setf dpsi
                                                             (+ dpsi
                                                                (* temp
                                                                   temp)))
                                                       (setf erretm
                                                             (+ erretm
                                                                psi))
                                                     label80))
                                     (setf erretm (abs erretm))
                                     (setf temp
                                           (/ (f2cl-lib:fref z-%data%
                                                             (n)
                                                             ((1 *))
                                                             z-%offset%)
                                              (* (f2cl-lib:fref work-%data%
                                                                (n)
                                                                ((1 *))
                                                                work-%offset%)
                                                 (f2cl-lib:fref delta-%data%
                                                                (n)
                                                                ((1 *))
                                                                delta-%offset%))))
                                     (setf phi
                                           (* (f2cl-lib:fref z-%data%
                                                             (n)
                                                             ((1 *))
                                                             z-%offset%)
                                              temp))
                                     (setf dphi (* temp temp))
                                     (setf erretm
                                           (+ (- (+ (* eight
                                                       (- (- psi) phi))
                                                    erretm)
                                                 phi)
                                              rhoinv
                                              (* (abs tau)
                                                 (+ dpsi dphi))))
                                     (setf w (+ rhoinv phi psi))
                                   label90))
                   (setf info 1)
                   (go label240))
                  (t
                   (setf niter 1)
                   (setf ip1 (f2cl-lib:int-add i 1))
                   (setf delsq
                         (* (- (f2cl-lib:fref d-%data% (ip1) ((1 *))
                                              d-%offset%)
                               (f2cl-lib:fref d-%data% (i) ((1 *))
                                              d-%offset%))
                            (+ (f2cl-lib:fref d-%data% (ip1) ((1 *))
                                              d-%offset%)
                               (f2cl-lib:fref d-%data% (i) ((1 *))
                                              d-%offset%))))
                   (setf delsq2 (/ delsq two))
                   (setf temp
                         (/ delsq2
                            (+ (f2cl-lib:fref d-%data% (i) ((1 *))
                                              d-%offset%)
                               (f2cl-lib:fsqrt (+ (* (f2cl-lib:fref d-%data%
                                                                    (i)
                                                                    ((1
                                                                      *))
                                                                    d-%offset%)
                                                     (f2cl-lib:fref d-%data%
                                                                    (i)
                                                                    ((1
                                                                      *))
                                                                    d-%offset%))
                                                  delsq2)))))
                   (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
                                 ((> j n) nil)
                                 (tagbody
                                     (setf (f2cl-lib:fref work-%data%
                                                          (j) ((1 *))
                                                          work-%offset%)
                                           (+ (f2cl-lib:fref d-%data%
                                                             (j)
                                                             ((1 *))
                                                             d-%offset%)
                                              (f2cl-lib:fref d-%data%
                                                             (i)
                                                             ((1 *))
                                                             d-%offset%)
                                              temp))
                                     (setf (f2cl-lib:fref delta-%data%
                                                          (j) ((1 *))
                                                          delta-%offset%)
                                           (- (f2cl-lib:fref d-%data%
                                                             (j)
                                                             ((1 *))
                                                             d-%offset%)
                                              (f2cl-lib:fref d-%data%
                                                             (i)
                                                             ((1 *))
                                                             d-%offset%)
                                              temp))
                                   label100))
                   (setf psi zero)
                   (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
                                 ((> j
                                     (f2cl-lib:int-add i
                                                       (f2cl-lib:int-sub 1)))
                                  nil)
                                 (tagbody
                                     (setf psi
                                           (+ psi
                                              (/ (* (f2cl-lib:fref z-%data%
                                                                   (j)
                                                                   ((1
                                                                     *))
                                                                   z-%offset%)
                                                    (f2cl-lib:fref z-%data%
                                                                   (j)
                                                                   ((1
                                                                     *))
                                                                   z-%offset%))
                                                 (* (f2cl-lib:fref work-%data%
                                                                   (j)
                                                                   ((1
                                                                     *))
                                                                   work-%offset%)
                                                    (f2cl-lib:fref delta-%data%
                                                                   (j)
                                                                   ((1
                                                                     *))
                                                                   delta-%offset%)))))
                                   label110))
                   (setf phi zero)
                   (f2cl-lib:fdo (j n
                                  (f2cl-lib:int-add j
                                                    (f2cl-lib:int-sub 1)))
                                 ((> j (f2cl-lib:int-add i 2)) nil)
                                 (tagbody
                                     (setf phi
                                           (+ phi
                                              (/ (* (f2cl-lib:fref z-%data%
                                                                   (j)
                                                                   ((1
                                                                     *))
                                                                   z-%offset%)
                                                    (f2cl-lib:fref z-%data%
                                                                   (j)
                                                                   ((1
                                                                     *))
                                                                   z-%offset%))
                                                 (* (f2cl-lib:fref work-%data%
                                                                   (j)
                                                                   ((1
                                                                     *))
                                                                   work-%offset%)
                                                    (f2cl-lib:fref delta-%data%
                                                                   (j)
                                                                   ((1
                                                                     *))
                                                                   delta-%offset%)))))
                                   label120))
                   (setf c (+ rhoinv psi phi))
                   (setf w
                         (+ c
                            (/ (* (f2cl-lib:fref z-%data% (i) ((1 *))
                                                 z-%offset%)
                                  (f2cl-lib:fref z-%data% (i) ((1 *))
                                                 z-%offset%))
                               (* (f2cl-lib:fref work-%data% (i)
                                                 ((1 *)) work-%offset%)
                                  (f2cl-lib:fref delta-%data% (i)
                                                 ((1 *))
                                                 delta-%offset%)))
                            (/ (* (f2cl-lib:fref z-%data% (ip1) ((1 *))
                                                 z-%offset%)
                                  (f2cl-lib:fref z-%data% (ip1) ((1 *))
                                                 z-%offset%))
                               (* (f2cl-lib:fref work-%data% (ip1)
                                                 ((1 *)) work-%offset%)
                                  (f2cl-lib:fref delta-%data% (ip1)
                                                 ((1 *))
                                                 delta-%offset%)))))
                   (cond ((> w zero)
                          (setf orgati f2cl-lib:%true%)
                          (setf sg2lb zero)
                          (setf sg2ub delsq2)
                          (setf a
                                (+ (* c delsq)
                                   (* (f2cl-lib:fref z-%data% (i)
                                                     ((1 *))
                                                     z-%offset%)
                                      (f2cl-lib:fref z-%data% (i)
                                                     ((1 *))
                                                     z-%offset%))
                                   (* (f2cl-lib:fref z-%data% (ip1)
                                                     ((1 *))
                                                     z-%offset%)
                                      (f2cl-lib:fref z-%data% (ip1)
                                                     ((1 *))
                                                     z-%offset%))))
                          (setf b
                                (* (f2cl-lib:fref z-%data% (i) ((1 *))
                                                  z-%offset%)
                                   (f2cl-lib:fref z-%data% (i) ((1 *))
                                                  z-%offset%)
                                   delsq))
                          (cond ((> a zero)
                                 (setf tau
                                       (/ (* two b)
                                          (+ a
                                             (f2cl-lib:fsqrt (abs (+ (* a
                                                                        a)
                                                                     (* (- four)
                                                                        b
                                                                        c))))))))
                                (t
                                 (setf tau
                                       (/ (- a
                                             (f2cl-lib:fsqrt (abs (+ (* a
                                                                        a)
                                                                     (* (- four)
                                                                        b
                                                                        c)))))
                                          (* two c)))))
                          (setf eta
                                (/ tau
                                   (+ (f2cl-lib:fref d-%data% (i)
                                                     ((1 *))
                                                     d-%offset%)
                                      (f2cl-lib:fsqrt (+ (* (f2cl-lib:fref d-%data%
                                                                           (i)
                                                                           ((1
                                                                             *))
                                                                           d-%offset%)
                                                            (f2cl-lib:fref d-%data%
                                                                           (i)
                                                                           ((1
                                                                             *))
                                                                           d-%offset%))
                                                         tau))))))
                         (t
                          (setf orgati f2cl-lib:%false%)
                          (setf sg2lb (- delsq2))
                          (setf sg2ub zero)
                          (setf a
                                (- (* c delsq)
                                   (* (f2cl-lib:fref z-%data% (i)
                                                     ((1 *))
                                                     z-%offset%)
                                      (f2cl-lib:fref z-%data% (i)
                                                     ((1 *))
                                                     z-%offset%))
                                   (* (f2cl-lib:fref z-%data% (ip1)
                                                     ((1 *))
                                                     z-%offset%)
                                      (f2cl-lib:fref z-%data% (ip1)
                                                     ((1 *))
                                                     z-%offset%))))
                          (setf b
                                (* (f2cl-lib:fref z-%data% (ip1)
                                                  ((1 *)) z-%offset%)
                                   (f2cl-lib:fref z-%data% (ip1)
                                                  ((1 *)) z-%offset%)
                                   delsq))
                          (cond ((< a zero)
                                 (setf tau
                                       (/ (* two b)
                                          (- a
                                             (f2cl-lib:fsqrt (abs (+ (* a
                                                                        a)
                                                                     (* four
                                                                        b
                                                                        c))))))))
                                (t
                                 (setf tau
                                       (/ (- (+ a
                                                (f2cl-lib:fsqrt (abs (+ (* a
                                                                           a)
                                                                        (* four
                                                                           b
                                                                           c))))))
                                          (* two c)))))
                          (setf eta
                                (/ tau
                                   (+ (f2cl-lib:fref d-%data% (ip1)
                                                     ((1 *))
                                                     d-%offset%)
                                      (f2cl-lib:fsqrt (abs (+ (* (f2cl-lib:fref d-%data%
                                                                                (ip1)
                                                                                ((1
                                                                                  *))
                                                                                d-%offset%)
                                                                 (f2cl-lib:fref d-%data%
                                                                                (ip1)
                                                                                ((1
                                                                                  *))
                                                                                d-%offset%))
                                                              tau))))))))
                   (cond (orgati
                          (setf ii i)
                          (setf sigma
                                (+ (f2cl-lib:fref d-%data% (i) ((1 *))
                                                  d-%offset%)
                                   eta))
                          (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
                                        ((> j n) nil)
                                        (tagbody
                                            (setf (f2cl-lib:fref work-%data%
                                                                 (j)
                                                                 ((1
                                                                   *))
                                                                 work-%offset%)
                                                  (+ (f2cl-lib:fref d-%data%
                                                                    (j)
                                                                    ((1
                                                                      *))
                                                                    d-%offset%)
                                                     (f2cl-lib:fref d-%data%
                                                                    (i)
                                                                    ((1
                                                                      *))
                                                                    d-%offset%)
                                                     eta))
                                            (setf (f2cl-lib:fref delta-%data%
                                                                 (j)
                                                                 ((1
                                                                   *))
                                                                 delta-%offset%)
                                                  (- (f2cl-lib:fref d-%data%
                                                                    (j)
                                                                    ((1
                                                                      *))
                                                                    d-%offset%)
                                                     (f2cl-lib:fref d-%data%
                                                                    (i)
                                                                    ((1
                                                                      *))
                                                                    d-%offset%)
                                                     eta))
                                          label130)))
                         (t
                          (setf ii (f2cl-lib:int-add i 1))
                          (setf sigma
                                (+ (f2cl-lib:fref d-%data% (ip1)
                                                  ((1 *)) d-%offset%)
                                   eta))
                          (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
                                        ((> j n) nil)
                                        (tagbody
                                            (setf (f2cl-lib:fref work-%data%
                                                                 (j)
                                                                 ((1
                                                                   *))
                                                                 work-%offset%)
                                                  (+ (f2cl-lib:fref d-%data%
                                                                    (j)
                                                                    ((1
                                                                      *))
                                                                    d-%offset%)
                                                     (f2cl-lib:fref d-%data%
                                                                    (ip1)
                                                                    ((1
                                                                      *))
                                                                    d-%offset%)
                                                     eta))
                                            (setf (f2cl-lib:fref delta-%data%
                                                                 (j)
                                                                 ((1
                                                                   *))
                                                                 delta-%offset%)
                                                  (- (f2cl-lib:fref d-%data%
                                                                    (j)
                                                                    ((1
                                                                      *))
                                                                    d-%offset%)
                                                     (f2cl-lib:fref d-%data%
                                                                    (ip1)
                                                                    ((1
                                                                      *))
                                                                    d-%offset%)
                                                     eta))
                                          label140))))
                   (setf iim1 (f2cl-lib:int-sub ii 1))
                   (setf iip1 (f2cl-lib:int-add ii 1))
                   (setf dpsi zero)
                   (setf psi zero)
                   (setf erretm zero)
                   (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
                                 ((> j iim1) nil)
                                 (tagbody
                                     (setf temp
                                           (/ (f2cl-lib:fref z-%data%
                                                             (j)
                                                             ((1 *))
                                                             z-%offset%)
                                              (* (f2cl-lib:fref work-%data%
                                                                (j)
                                                                ((1 *))
                                                                work-%offset%)
                                                 (f2cl-lib:fref delta-%data%
                                                                (j)
                                                                ((1 *))
                                                                delta-%offset%))))
                                     (setf psi
                                           (+ psi
                                              (* (f2cl-lib:fref z-%data%
                                                                (j)
                                                                ((1 *))
                                                                z-%offset%)
                                                 temp)))
                                     (setf dpsi (+ dpsi (* temp temp)))
                                     (setf erretm (+ erretm psi))
                                   label150))
                   (setf erretm (abs erretm))
                   (setf dphi zero)
                   (setf phi zero)
                   (f2cl-lib:fdo (j n
                                  (f2cl-lib:int-add j
                                                    (f2cl-lib:int-sub 1)))
                                 ((> j iip1) nil)
                                 (tagbody
                                     (setf temp
                                           (/ (f2cl-lib:fref z-%data%
                                                             (j)
                                                             ((1 *))
                                                             z-%offset%)
                                              (* (f2cl-lib:fref work-%data%
                                                                (j)
                                                                ((1 *))
                                                                work-%offset%)
                                                 (f2cl-lib:fref delta-%data%
                                                                (j)
                                                                ((1 *))
                                                                delta-%offset%))))
                                     (setf phi
                                           (+ phi
                                              (* (f2cl-lib:fref z-%data%
                                                                (j)
                                                                ((1 *))
                                                                z-%offset%)
                                                 temp)))
                                     (setf dphi (+ dphi (* temp temp)))
                                     (setf erretm (+ erretm phi))
                                   label160))
                   (setf w (+ rhoinv phi psi))
                   (setf swtch3 f2cl-lib:%false%)
                   (cond (orgati
                          (if (< w zero)
                              (setf swtch3 f2cl-lib:%true%)))
                         (t
                          (if (> w zero)
                              (setf swtch3 f2cl-lib:%true%))))
                   (if (or (= ii 1) (= ii n))
                       (setf swtch3 f2cl-lib:%false%))
                   (setf temp
                         (/ (f2cl-lib:fref z-%data% (ii) ((1 *))
                                           z-%offset%)
                            (* (f2cl-lib:fref work-%data% (ii) ((1 *))
                                              work-%offset%)
                               (f2cl-lib:fref delta-%data% (ii) ((1 *))
                                              delta-%offset%))))
                   (setf dw (+ dpsi dphi (* temp temp)))
                   (setf temp
                         (* (f2cl-lib:fref z-%data% (ii) ((1 *))
                                           z-%offset%)
                            temp))
                   (setf w (+ w temp))
                   (setf erretm
                         (+ (* eight (- phi psi)) erretm (* two rhoinv)
                            (* three (abs temp)) (* (abs tau) dw)))
                   (cond ((<= (abs w) (* eps erretm)) (go label240)))
                   (cond ((<= w zero) (setf sg2lb (max sg2lb tau)))
                         (t (setf sg2ub (min sg2ub tau))))
                   (setf niter (f2cl-lib:int-add niter 1))
                   (cond ((not swtch3)
                          (setf dtipsq
                                (* (f2cl-lib:fref work-%data% (ip1)
                                                  ((1 *))
                                                  work-%offset%)
                                   (f2cl-lib:fref delta-%data% (ip1)
                                                  ((1 *))
                                                  delta-%offset%)))
                          (setf dtisq
                                (* (f2cl-lib:fref work-%data% (i)
                                                  ((1 *))
                                                  work-%offset%)
                                   (f2cl-lib:fref delta-%data% (i)
                                                  ((1 *))
                                                  delta-%offset%)))
                          (cond (orgati
                                 (setf c
                                       (+ (- w (* dtipsq dw))
                                          (* delsq
                                             (expt (/ (f2cl-lib:fref z-%data%
                                                                     (i)
                                                                     ((1
                                                                       *))
                                                                     z-%offset%)
                                                      dtisq)
                                                   2)))))
                                (t
                                 (setf c
                                       (- w (* dtisq dw)
                                          (* delsq
                                             (expt (/ (f2cl-lib:fref z-%data%
                                                                     (ip1)
                                                                     ((1
                                                                       *))
                                                                     z-%offset%)
                                                      dtipsq)
                                                   2))))))
                          (setf a
                                (+ (* (+ dtipsq dtisq) w)
                                   (* (- dtipsq) dtisq dw)))
                          (setf b (* dtipsq dtisq w))
                          (cond ((= c zero)
                                 (cond ((= a zero)
                                        (cond (orgati
                                               (setf a
                                                     (+ (* (f2cl-lib:fref z-%data%
                                                                          (i)
                                                                          ((1
                                                                            *))
                                                                          z-%offset%)
                                                           (f2cl-lib:fref z-%data%
                                                                          (i)
                                                                          ((1
                                                                            *))
                                                                          z-%offset%))
                                                        (* dtipsq
                                                           dtipsq
                                                           (+ dpsi
                                                              dphi)))))
                                              (t
                                               (setf a
                                                     (+ (* (f2cl-lib:fref z-%data%
                                                                          (ip1)
                                                                          ((1
                                                                            *))
                                                                          z-%offset%)
                                                           (f2cl-lib:fref z-%data%
                                                                          (ip1)
                                                                          ((1
                                                                            *))
                                                                          z-%offset%))
                                                        (* dtisq dtisq
                                                           (+ dpsi
                                                              dphi))))))))
                                 (setf eta (/ b a)))
                                ((<= a zero)
                                 (setf eta
                                       (/ (- a
                                             (f2cl-lib:fsqrt (abs (+ (* a
                                                                        a)
                                                                     (* (- four)
                                                                        b
                                                                        c)))))
                                          (* two c))))
                                (t
                                 (setf eta
                                       (/ (* two b)
                                          (+ a
                                             (f2cl-lib:fsqrt (abs (+ (* a
                                                                        a)
                                                                     (* (- four)
                                                                        b
                                                                        c))))))))))
                         (t
                          (setf dtiim
                                (* (f2cl-lib:fref work-%data% (iim1)
                                                  ((1 *))
                                                  work-%offset%)
                                   (f2cl-lib:fref delta-%data% (iim1)
                                                  ((1 *))
                                                  delta-%offset%)))
                          (setf dtiip
                                (* (f2cl-lib:fref work-%data% (iip1)
                                                  ((1 *))
                                                  work-%offset%)
                                   (f2cl-lib:fref delta-%data% (iip1)
                                                  ((1 *))
                                                  delta-%offset%)))
                          (setf temp (+ rhoinv psi phi))
                          (cond (orgati
                                 (setf temp1
                                       (/ (f2cl-lib:fref z-%data%
                                                         (iim1) ((1 *))
                                                         z-%offset%)
                                          dtiim))
                                 (setf temp1 (* temp1 temp1))
                                 (setf c
                                       (+ (- temp
                                             (* dtiip (+ dpsi dphi)))
                                          (* (- (- (f2cl-lib:fref d-%data%
                                                                  (iim1)
                                                                  ((1
                                                                    *))
                                                                  d-%offset%)
                                                   (f2cl-lib:fref d-%data%
                                                                  (iip1)
                                                                  ((1
                                                                    *))
                                                                  d-%offset%)))
                                             (+ (f2cl-lib:fref d-%data%
                                                               (iim1)
                                                               ((1 *))
                                                               d-%offset%)
                                                (f2cl-lib:fref d-%data%
                                                               (iip1)
                                                               ((1 *))
                                                               d-%offset%))
                                             temp1)))
                                 (setf (f2cl-lib:fref zz (1) ((1 3)))
                                       (* (f2cl-lib:fref z-%data%
                                                         (iim1) ((1 *))
                                                         z-%offset%)
                                          (f2cl-lib:fref z-%data%
                                                         (iim1) ((1 *))
                                                         z-%offset%)))
                                 (cond ((< dpsi temp1)
                                        (setf (f2cl-lib:fref zz (3)
                                                             ((1 3)))
                                              (* dtiip dtiip dphi)))
                                       (t
                                        (setf (f2cl-lib:fref zz (3)
                                                             ((1 3)))
                                              (* dtiip dtiip
                                                 (+ (- dpsi temp1)
                                                    dphi))))))
                                (t
                                 (setf temp1
                                       (/ (f2cl-lib:fref z-%data%
                                                         (iip1) ((1 *))
                                                         z-%offset%)
                                          dtiip))
                                 (setf temp1 (* temp1 temp1))
                                 (setf c
                                       (+ (- temp
                                             (* dtiim (+ dpsi dphi)))
                                          (* (- (- (f2cl-lib:fref d-%data%
                                                                  (iip1)
                                                                  ((1
                                                                    *))
                                                                  d-%offset%)
                                                   (f2cl-lib:fref d-%data%
                                                                  (iim1)
                                                                  ((1
                                                                    *))
                                                                  d-%offset%)))
                                             (+ (f2cl-lib:fref d-%data%
                                                               (iim1)
                                                               ((1 *))
                                                               d-%offset%)
                                                (f2cl-lib:fref d-%data%
                                                               (iip1)
                                                               ((1 *))
                                                               d-%offset%))
                                             temp1)))
                                 (cond ((< dphi temp1)
                                        (setf (f2cl-lib:fref zz (1)
                                                             ((1 3)))
                                              (* dtiim dtiim dpsi)))
                                       (t
                                        (setf (f2cl-lib:fref zz (1)
                                                             ((1 3)))
                                              (* dtiim dtiim
                                                 (+ dpsi
                                                    (- dphi temp1))))))
                                 (setf (f2cl-lib:fref zz (3) ((1 3)))
                                       (* (f2cl-lib:fref z-%data%
                                                         (iip1) ((1 *))
                                                         z-%offset%)
                                          (f2cl-lib:fref z-%data%
                                                         (iip1) ((1 *))
                                                         z-%offset%)))))
                          (setf (f2cl-lib:fref zz (2) ((1 3)))
                                (* (f2cl-lib:fref z-%data% (ii) ((1 *))
                                                  z-%offset%)
                                   (f2cl-lib:fref z-%data% (ii) ((1 *))
                                                  z-%offset%)))
                          (setf (f2cl-lib:fref dd (1) ((1 3))) dtiim)
                          (setf (f2cl-lib:fref dd (2) ((1 3)))
                                (* (f2cl-lib:fref delta-%data% (ii)
                                                  ((1 *))
                                                  delta-%offset%)
                                   (f2cl-lib:fref work-%data% (ii)
                                                  ((1 *))
                                                  work-%offset%)))
                          (setf (f2cl-lib:fref dd (3) ((1 3))) dtiip)
                          (multiple-value-bind (var-0 var-1 var-2 var-3
                                                var-4 var-5 var-6
                                                var-7)
                              (dlaed6 niter orgati c dd zz w eta info)
                            (declare
                             (ignore var-0 var-1 var-2 var-3 var-4
                              var-5))
                            (setf eta var-6)
                            (setf info var-7))
                          (if (/= info 0) (go label240))))
                   (if (>= (* w eta) zero) (setf eta (/ (- w) dw)))
                   (cond (orgati
                          (setf temp1
                                (* (f2cl-lib:fref work-%data% (i)
                                                  ((1 *))
                                                  work-%offset%)
                                   (f2cl-lib:fref delta-%data% (i)
                                                  ((1 *))
                                                  delta-%offset%)))
                          (setf temp (- eta temp1)))
                         (t
                          (setf temp1
                                (* (f2cl-lib:fref work-%data% (ip1)
                                                  ((1 *))
                                                  work-%offset%)
                                   (f2cl-lib:fref delta-%data% (ip1)
                                                  ((1 *))
                                                  delta-%offset%)))
                          (setf temp (- eta temp1))))
                   (cond ((or (> temp sg2ub) (< temp sg2lb))
                          (cond ((< w zero)
                                 (setf eta (/ (- sg2ub tau) two)))
                                (t (setf eta (/ (- sg2lb tau) two))))))
                   (setf tau (+ tau eta))
                   (setf eta
                         (/ eta
                            (+ sigma
                               (f2cl-lib:fsqrt (+ (* sigma sigma)
                                                  eta)))))
                   (setf prew w)
                   (setf sigma (+ sigma eta))
                   (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
                                 ((> j n) nil)
                                 (tagbody
                                     (setf (f2cl-lib:fref work-%data%
                                                          (j) ((1 *))
                                                          work-%offset%)
                                           (+ (f2cl-lib:fref work-%data%
                                                             (j)
                                                             ((1 *))
                                                             work-%offset%)
                                              eta))
                                     (setf (f2cl-lib:fref delta-%data%
                                                          (j) ((1 *))
                                                          delta-%offset%)
                                           (- (f2cl-lib:fref delta-%data%
                                                             (j)
                                                             ((1 *))
                                                             delta-%offset%)
                                              eta))
                                   label170))
                   (setf dpsi zero)
                   (setf psi zero)
                   (setf erretm zero)
                   (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
                                 ((> j iim1) nil)
                                 (tagbody
                                     (setf temp
                                           (/ (f2cl-lib:fref z-%data%
                                                             (j)
                                                             ((1 *))
                                                             z-%offset%)
                                              (* (f2cl-lib:fref work-%data%
                                                                (j)
                                                                ((1 *))
                                                                work-%offset%)
                                                 (f2cl-lib:fref delta-%data%
                                                                (j)
                                                                ((1 *))
                                                                delta-%offset%))))
                                     (setf psi
                                           (+ psi
                                              (* (f2cl-lib:fref z-%data%
                                                                (j)
                                                                ((1 *))
                                                                z-%offset%)
                                                 temp)))
                                     (setf dpsi (+ dpsi (* temp temp)))
                                     (setf erretm (+ erretm psi))
                                   label180))
                   (setf erretm (abs erretm))
                   (setf dphi zero)
                   (setf phi zero)
                   (f2cl-lib:fdo (j n
                                  (f2cl-lib:int-add j
                                                    (f2cl-lib:int-sub 1)))
                                 ((> j iip1) nil)
                                 (tagbody
                                     (setf temp
                                           (/ (f2cl-lib:fref z-%data%
                                                             (j)
                                                             ((1 *))
                                                             z-%offset%)
                                              (* (f2cl-lib:fref work-%data%
                                                                (j)
                                                                ((1 *))
                                                                work-%offset%)
                                                 (f2cl-lib:fref delta-%data%
                                                                (j)
                                                                ((1 *))
                                                                delta-%offset%))))
                                     (setf phi
                                           (+ phi
                                              (* (f2cl-lib:fref z-%data%
                                                                (j)
                                                                ((1 *))
                                                                z-%offset%)
                                                 temp)))
                                     (setf dphi (+ dphi (* temp temp)))
                                     (setf erretm (+ erretm phi))
                                   label190))
                   (setf temp
                         (/ (f2cl-lib:fref z-%data% (ii) ((1 *))
                                           z-%offset%)
                            (* (f2cl-lib:fref work-%data% (ii) ((1 *))
                                              work-%offset%)
                               (f2cl-lib:fref delta-%data% (ii) ((1 *))
                                              delta-%offset%))))
                   (setf dw (+ dpsi dphi (* temp temp)))
                   (setf temp
                         (* (f2cl-lib:fref z-%data% (ii) ((1 *))
                                           z-%offset%)
                            temp))
                   (setf w (+ rhoinv phi psi temp))
                   (setf erretm
                         (+ (* eight (- phi psi)) erretm (* two rhoinv)
                            (* three (abs temp)) (* (abs tau) dw)))
                   (cond ((<= w zero) (setf sg2lb (max sg2lb tau)))
                         (t (setf sg2ub (min sg2ub tau))))
                   (setf swtch f2cl-lib:%false%)
                   (cond (orgati
                          (if (> (- w) (/ (abs prew) ten))
                              (setf swtch f2cl-lib:%true%)))
                         (t
                          (if (> w (/ (abs prew) ten))
                              (setf swtch f2cl-lib:%true%))))
                   (setf iter (f2cl-lib:int-add niter 1))
                   (f2cl-lib:fdo (niter iter
                                  (f2cl-lib:int-add niter 1))
                                 ((> niter maxit) nil)
                                 (tagbody
                                     (cond ((<= (abs w) (* eps erretm))
                                            (go label240)))
                                     (cond ((not swtch3)
                                            (setf dtipsq
                                                  (* (f2cl-lib:fref work-%data%
                                                                    (ip1)
                                                                    ((1
                                                                      *))
                                                                    work-%offset%)
                                                     (f2cl-lib:fref delta-%data%
                                                                    (ip1)
                                                                    ((1
                                                                      *))
                                                                    delta-%offset%)))
                                            (setf dtisq
                                                  (* (f2cl-lib:fref work-%data%
                                                                    (i)
                                                                    ((1
                                                                      *))
                                                                    work-%offset%)
                                                     (f2cl-lib:fref delta-%data%
                                                                    (i)
                                                                    ((1
                                                                      *))
                                                                    delta-%offset%)))
                                            (cond ((not swtch)
                                                   (cond (orgati
                                                          (setf c
                                                                (+ (- w
                                                                      (* dtipsq
                                                                         dw))
                                                                   (* delsq
                                                                      (expt (/ (f2cl-lib:fref z-%data%
                                                                                              (i)
                                                                                              ((1
                                                                                                *))
                                                                                              z-%offset%)
                                                                               dtisq)
                                                                            2)))))
                                                         (t
                                                          (setf c
                                                                (- w
                                                                   (* dtisq
                                                                      dw)
                                                                   (* delsq
                                                                      (expt (/ (f2cl-lib:fref z-%data%
                                                                                              (ip1)
                                                                                              ((1
                                                                                                *))
                                                                                              z-%offset%)
                                                                               dtipsq)
                                                                            2)))))))
                                                  (t
                                                   (setf temp
                                                         (/ (f2cl-lib:fref z-%data%
                                                                           (ii)
                                                                           ((1
                                                                             *))
                                                                           z-%offset%)
                                                            (* (f2cl-lib:fref work-%data%
                                                                              (ii)
                                                                              ((1
                                                                                *))
                                                                              work-%offset%)
                                                               (f2cl-lib:fref delta-%data%
                                                                              (ii)
                                                                              ((1
                                                                                *))
                                                                              delta-%offset%))))
                                                   (cond (orgati
                                                          (setf dpsi
                                                                (+ dpsi
                                                                   (* temp
                                                                      temp))))
                                                         (t
                                                          (setf dphi
                                                                (+ dphi
                                                                   (* temp
                                                                      temp)))))
                                                   (setf c
                                                         (- w
                                                            (* dtisq
                                                               dpsi)
                                                            (* dtipsq
                                                               dphi)))))
                                            (setf a
                                                  (+ (* (+ dtipsq
                                                           dtisq)
                                                        w)
                                                     (* (- dtipsq)
                                                        dtisq dw)))
                                            (setf b (* dtipsq dtisq w))
                                            (cond ((= c zero)
                                                   (cond ((= a zero)
                                                          (cond ((not swtch)
                                                                 (cond (orgati
                                                                        (setf a
                                                                              (+ (* (f2cl-lib:fref z-%data%
                                                                                                   (i)
                                                                                                   ((1
                                                                                                     *))
                                                                                                   z-%offset%)
                                                                                    (f2cl-lib:fref z-%data%
                                                                                                   (i)
                                                                                                   ((1
                                                                                                     *))
                                                                                                   z-%offset%))
                                                                                 (* dtipsq
                                                                                    dtipsq
                                                                                    (+ dpsi
                                                                                       dphi)))))
                                                                       (t
                                                                        (setf a
                                                                              (+ (* (f2cl-lib:fref z-%data%
                                                                                                   (ip1)
                                                                                                   ((1
                                                                                                     *))
                                                                                                   z-%offset%)
                                                                                    (f2cl-lib:fref z-%data%
                                                                                                   (ip1)
                                                                                                   ((1
                                                                                                     *))
                                                                                                   z-%offset%))
                                                                                 (* dtisq
                                                                                    dtisq
                                                                                    (+ dpsi
                                                                                       dphi)))))))
                                                                (t
                                                                 (setf a
                                                                       (+ (* dtisq
                                                                             dtisq
                                                                             dpsi)
                                                                          (* dtipsq
                                                                             dtipsq
                                                                             dphi)))))))
                                                   (setf eta (/ b a)))
                                                  ((<= a zero)
                                                   (setf eta
                                                         (/ (- a
                                                               (f2cl-lib:fsqrt (abs (+ (* a
                                                                                          a)
                                                                                       (* (- four)
                                                                                          b
                                                                                          c)))))
                                                            (* two
                                                               c))))
                                                  (t
                                                   (setf eta
                                                         (/ (* two b)
                                                            (+ a
                                                               (f2cl-lib:fsqrt (abs (+ (* a
                                                                                          a)
                                                                                       (* (- four)
                                                                                          b
                                                                                          c))))))))))
                                           (t
                                            (setf dtiim
                                                  (* (f2cl-lib:fref work-%data%
                                                                    (iim1)
                                                                    ((1
                                                                      *))
                                                                    work-%offset%)
                                                     (f2cl-lib:fref delta-%data%
                                                                    (iim1)
                                                                    ((1
                                                                      *))
                                                                    delta-%offset%)))
                                            (setf dtiip
                                                  (* (f2cl-lib:fref work-%data%
                                                                    (iip1)
                                                                    ((1
                                                                      *))
                                                                    work-%offset%)
                                                     (f2cl-lib:fref delta-%data%
                                                                    (iip1)
                                                                    ((1
                                                                      *))
                                                                    delta-%offset%)))
                                            (setf temp
                                                  (+ rhoinv psi phi))
                                            (cond (swtch
                                                   (setf c
                                                         (- temp
                                                            (* dtiim
                                                               dpsi)
                                                            (* dtiip
                                                               dphi)))
                                                   (setf (f2cl-lib:fref zz
                                                                        (1)
                                                                        ((1
                                                                          3)))
                                                         (* dtiim dtiim
                                                            dpsi))
                                                   (setf (f2cl-lib:fref zz
                                                                        (3)
                                                                        ((1
                                                                          3)))
                                                         (* dtiip dtiip
                                                            dphi)))
                                                  (t
                                                   (cond (orgati
                                                          (setf temp1
                                                                (/ (f2cl-lib:fref z-%data%
                                                                                  (iim1)
                                                                                  ((1
                                                                                    *))
                                                                                  z-%offset%)
                                                                   dtiim))
                                                          (setf temp1
                                                                (* temp1
                                                                   temp1))
                                                          (setf temp2
                                                                (* (- (f2cl-lib:fref d-%data%
                                                                                     (iim1)
                                                                                     ((1
                                                                                       *))
                                                                                     d-%offset%)
                                                                      (f2cl-lib:fref d-%data%
                                                                                     (iip1)
                                                                                     ((1
                                                                                       *))
                                                                                     d-%offset%))
                                                                   (+ (f2cl-lib:fref d-%data%
                                                                                     (iim1)
                                                                                     ((1
                                                                                       *))
                                                                                     d-%offset%)
                                                                      (f2cl-lib:fref d-%data%
                                                                                     (iip1)
                                                                                     ((1
                                                                                       *))
                                                                                     d-%offset%))
                                                                   temp1))
                                                          (setf c
                                                                (- temp
                                                                   (* dtiip
                                                                      (+ dpsi
                                                                         dphi))
                                                                   temp2))
                                                          (setf (f2cl-lib:fref zz
                                                                               (1)
                                                                               ((1
                                                                                 3)))
                                                                (* (f2cl-lib:fref z-%data%
                                                                                  (iim1)
                                                                                  ((1
                                                                                    *))
                                                                                  z-%offset%)
                                                                   (f2cl-lib:fref z-%data%
                                                                                  (iim1)
                                                                                  ((1
                                                                                    *))
                                                                                  z-%offset%)))
                                                          (cond ((< dpsi
                                                                    temp1)
                                                                 (setf (f2cl-lib:fref zz
                                                                                      (3)
                                                                                      ((1
                                                                                        3)))
                                                                       (* dtiip
                                                                          dtiip
                                                                          dphi)))
                                                                (t
                                                                 (setf (f2cl-lib:fref zz
                                                                                      (3)
                                                                                      ((1
                                                                                        3)))
                                                                       (* dtiip
                                                                          dtiip
                                                                          (+ (- dpsi
                                                                                temp1)
                                                                             dphi))))))
                                                         (t
                                                          (setf temp1
                                                                (/ (f2cl-lib:fref z-%data%
                                                                                  (iip1)
                                                                                  ((1
                                                                                    *))
                                                                                  z-%offset%)
                                                                   dtiip))
                                                          (setf temp1
                                                                (* temp1
                                                                   temp1))
                                                          (setf temp2
                                                                (* (- (f2cl-lib:fref d-%data%
                                                                                     (iip1)
                                                                                     ((1
                                                                                       *))
                                                                                     d-%offset%)
                                                                      (f2cl-lib:fref d-%data%
                                                                                     (iim1)
                                                                                     ((1
                                                                                       *))
                                                                                     d-%offset%))
                                                                   (+ (f2cl-lib:fref d-%data%
                                                                                     (iim1)
                                                                                     ((1
                                                                                       *))
                                                                                     d-%offset%)
                                                                      (f2cl-lib:fref d-%data%
                                                                                     (iip1)
                                                                                     ((1
                                                                                       *))
                                                                                     d-%offset%))
                                                                   temp1))
                                                          (setf c
                                                                (- temp
                                                                   (* dtiim
                                                                      (+ dpsi
                                                                         dphi))
                                                                   temp2))
                                                          (cond ((< dphi
                                                                    temp1)
                                                                 (setf (f2cl-lib:fref zz
                                                                                      (1)
                                                                                      ((1
                                                                                        3)))
                                                                       (* dtiim
                                                                          dtiim
                                                                          dpsi)))
                                                                (t
                                                                 (setf (f2cl-lib:fref zz
                                                                                      (1)
                                                                                      ((1
                                                                                        3)))
                                                                       (* dtiim
                                                                          dtiim
                                                                          (+ dpsi
                                                                             (- dphi
                                                                                temp1))))))
                                                          (setf (f2cl-lib:fref zz
                                                                               (3)
                                                                               ((1
                                                                                 3)))
                                                                (* (f2cl-lib:fref z-%data%
                                                                                  (iip1)
                                                                                  ((1
                                                                                    *))
                                                                                  z-%offset%)
                                                                   (f2cl-lib:fref z-%data%
                                                                                  (iip1)
                                                                                  ((1
                                                                                    *))
                                                                                  z-%offset%)))))))
                                            (setf (f2cl-lib:fref dd (1)
                                                                 ((1
                                                                   3)))
                                                  dtiim)
                                            (setf (f2cl-lib:fref dd (2)
                                                                 ((1
                                                                   3)))
                                                  (* (f2cl-lib:fref delta-%data%
                                                                    (ii)
                                                                    ((1
                                                                      *))
                                                                    delta-%offset%)
                                                     (f2cl-lib:fref work-%data%
                                                                    (ii)
                                                                    ((1
                                                                      *))
                                                                    work-%offset%)))
                                            (setf (f2cl-lib:fref dd (3)
                                                                 ((1
                                                                   3)))
                                                  dtiip)
                                            (multiple-value-bind (var-0
                                                                  var-1
                                                                  var-2
                                                                  var-3
                                                                  var-4
                                                                  var-5
                                                                  var-6
                                                                  var-7)
                                                (dlaed6 niter orgati c
                                                 dd zz w eta info)
                                              (declare
                                               (ignore var-0 var-1
                                                var-2 var-3 var-4
                                                var-5))
                                              (setf eta var-6)
                                              (setf info var-7))
                                            (if (/= info 0)
                                                (go label240))))
                                     (if (>= (* w eta) zero)
                                         (setf eta (/ (- w) dw)))
                                     (cond (orgati
                                            (setf temp1
                                                  (* (f2cl-lib:fref work-%data%
                                                                    (i)
                                                                    ((1
                                                                      *))
                                                                    work-%offset%)
                                                     (f2cl-lib:fref delta-%data%
                                                                    (i)
                                                                    ((1
                                                                      *))
                                                                    delta-%offset%)))
                                            (setf temp (- eta temp1)))
                                           (t
                                            (setf temp1
                                                  (* (f2cl-lib:fref work-%data%
                                                                    (ip1)
                                                                    ((1
                                                                      *))
                                                                    work-%offset%)
                                                     (f2cl-lib:fref delta-%data%
                                                                    (ip1)
                                                                    ((1
                                                                      *))
                                                                    delta-%offset%)))
                                            (setf temp (- eta temp1))))
                                     (cond ((or (> temp sg2ub)
                                                (< temp sg2lb))
                                            (cond ((< w zero)
                                                   (setf eta
                                                         (/ (- sg2ub
                                                               tau)
                                                            two)))
                                                  (t
                                                   (setf eta
                                                         (/ (- sg2lb
                                                               tau)
                                                            two))))))
                                     (setf tau (+ tau eta))
                                     (setf eta
                                           (/ eta
                                              (+ sigma
                                                 (f2cl-lib:fsqrt (+ (* sigma
                                                                       sigma)
                                                                    eta)))))
                                     (setf sigma (+ sigma eta))
                                     (f2cl-lib:fdo (j 1
                                                    (f2cl-lib:int-add j
                                                                      1))
                                                   ((> j n) nil)
                                                   (tagbody
                                                       (setf (f2cl-lib:fref work-%data%
                                                                            (j)
                                                                            ((1
                                                                              *))
                                                                            work-%offset%)
                                                             (+ (f2cl-lib:fref work-%data%
                                                                               (j)
                                                                               ((1
                                                                                 *))
                                                                               work-%offset%)
                                                                eta))
                                                       (setf (f2cl-lib:fref delta-%data%
                                                                            (j)
                                                                            ((1
                                                                              *))
                                                                            delta-%offset%)
                                                             (- (f2cl-lib:fref delta-%data%
                                                                               (j)
                                                                               ((1
                                                                                 *))
                                                                               delta-%offset%)
                                                                eta))
                                                     label200))
                                     (setf prew w)
                                     (setf dpsi zero)
                                     (setf psi zero)
                                     (setf erretm zero)
                                     (f2cl-lib:fdo (j 1
                                                    (f2cl-lib:int-add j
                                                                      1))
                                                   ((> j iim1) nil)
                                                   (tagbody
                                                       (setf temp
                                                             (/ (f2cl-lib:fref z-%data%
                                                                               (j)
                                                                               ((1
                                                                                 *))
                                                                               z-%offset%)
                                                                (* (f2cl-lib:fref work-%data%
                                                                                  (j)
                                                                                  ((1
                                                                                    *))
                                                                                  work-%offset%)
                                                                   (f2cl-lib:fref delta-%data%
                                                                                  (j)
                                                                                  ((1
                                                                                    *))
                                                                                  delta-%offset%))))
                                                       (setf psi
                                                             (+ psi
                                                                (* (f2cl-lib:fref z-%data%
                                                                                  (j)
                                                                                  ((1
                                                                                    *))
                                                                                  z-%offset%)
                                                                   temp)))
                                                       (setf dpsi
                                                             (+ dpsi
                                                                (* temp
                                                                   temp)))
                                                       (setf erretm
                                                             (+ erretm
                                                                psi))
                                                     label210))
                                     (setf erretm (abs erretm))
                                     (setf dphi zero)
                                     (setf phi zero)
                                     (f2cl-lib:fdo (j n
                                                    (f2cl-lib:int-add j
                                                                      (f2cl-lib:int-sub 1)))
                                                   ((> j iip1) nil)
                                                   (tagbody
                                                       (setf temp
                                                             (/ (f2cl-lib:fref z-%data%
                                                                               (j)
                                                                               ((1
                                                                                 *))
                                                                               z-%offset%)
                                                                (* (f2cl-lib:fref work-%data%
                                                                                  (j)
                                                                                  ((1
                                                                                    *))
                                                                                  work-%offset%)
                                                                   (f2cl-lib:fref delta-%data%
                                                                                  (j)
                                                                                  ((1
                                                                                    *))
                                                                                  delta-%offset%))))
                                                       (setf phi
                                                             (+ phi
                                                                (* (f2cl-lib:fref z-%data%
                                                                                  (j)
                                                                                  ((1
                                                                                    *))
                                                                                  z-%offset%)
                                                                   temp)))
                                                       (setf dphi
                                                             (+ dphi
                                                                (* temp
                                                                   temp)))
                                                       (setf erretm
                                                             (+ erretm
                                                                phi))
                                                     label220))
                                     (setf temp
                                           (/ (f2cl-lib:fref z-%data%
                                                             (ii)
                                                             ((1 *))
                                                             z-%offset%)
                                              (* (f2cl-lib:fref work-%data%
                                                                (ii)
                                                                ((1 *))
                                                                work-%offset%)
                                                 (f2cl-lib:fref delta-%data%
                                                                (ii)
                                                                ((1 *))
                                                                delta-%offset%))))
                                     (setf dw
                                           (+ dpsi dphi (* temp temp)))
                                     (setf temp
                                           (* (f2cl-lib:fref z-%data%
                                                             (ii)
                                                             ((1 *))
                                                             z-%offset%)
                                              temp))
                                     (setf w (+ rhoinv phi psi temp))
                                     (setf erretm
                                           (+ (* eight (- phi psi))
                                              erretm (* two rhoinv)
                                              (* three (abs temp))
                                              (* (abs tau) dw)))
                                     (if (and (> (* w prew) zero)
                                              (> (abs w)
                                                 (/ (abs prew) ten)))
                                         (setf swtch (not swtch)))
                                     (cond ((<= w zero)
                                            (setf sg2lb
                                                  (max sg2lb tau)))
                                           (t
                                            (setf sg2ub
                                                  (min sg2ub tau))))
                                   label230))
                   (setf info 1)))
       label240 (go end_label)
       end_label (return (values nil nil nil nil nil nil sigma nil
                                 info))))))

(in-package #-gcl #:cl-user #+gcl "CL-USER")
#+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
(eval-when (:load-toplevel :compile-toplevel :execute)
  (setf (gethash 'fortran-to-lisp::dlasd4
                 fortran-to-lisp::*f2cl-function-info*)
        (fortran-to-lisp::make-f2cl-finfo :arg-types '((fortran-to-lisp::integer4)
                                                       (fortran-to-lisp::integer4)
                                                       (array
                                                        double-float
                                                        (*))
                                                       (array
                                                        double-float
                                                        (*))
                                                       (array
                                                        double-float
                                                        (*))
                                                       (double-float)
                                                       (double-float)
                                                       (array
                                                        double-float
                                                        (*))
                                                       (fortran-to-lisp::integer4))
          :return-values '(nil nil nil nil nil nil
                           fortran-to-lisp::sigma nil
                           fortran-to-lisp::info)
          :calls '(fortran-to-lisp::dlaed6 fortran-to-lisp::dlamch
                   fortran-to-lisp::dlasd5))))

